home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.08 Aug 89 / Two Plotters Source / Plot - Nelson / UExtendedText.inc1.p < prev    next >
Encoding:
Text File  |  1989-04-12  |  11.0 KB  |  418 lines  |  [TEXT/MPS ]
  1.  
  2. (**********************************************************************************)
  3. (*    T E x t e n d e d T e x t                                                   *)
  4. (**********************************************************************************)
  5.  
  6. { By Calvin E. Cock (a.k.a. "Earnie") - Applications Design Group    }
  7. {                                       60 E. Hanover Road           }
  8. {                                       Morris Plains, NJ  07950     }
  9.  
  10. { R E V I S I O N   H I S T O R Y }
  11.  
  12. {  9/16/88 - Creation of TExtended Text Library Unit }
  13. {  9/28/88 - Corrected field identifier in FIELDS    }
  14. { 10/10/88 - Changed Min & Max to Extended, cleaned up code }
  15.  
  16. {$IFC qProceduralViews}
  17. {$S DlgOpen}
  18. {-----------------------------------+
  19. |    IExtendedText                          |
  20. +-----------------------------------}
  21. PROCEDURE TExtendedText.IExtendedText(itsSuperView: TView;
  22.                                               itsLocation, itsSize: VPoint;
  23.                                               itsMinimum, itsMaximum : Extended;
  24.                                               itsPrecision: integer;
  25.                                               itsValue : str255 );
  26. Var
  27.     IntHolder:    LongInt;
  28.     ExtHolder:    Extended;
  29.     Mask:            DecForm;
  30.  
  31.     
  32. BEGIN
  33.     IEditText(itsSuperView, itsLocation, itsSize, 255);
  34.     if itsminimum > itsmaximum then
  35.         begin
  36.             {$IFC qDebug}
  37.             Warning ( 1 );
  38.             {$ENDC}
  39.             ExtHolder := itsminimum;
  40.             itsminimum := itsmaximum;
  41.             itsmaximum := ExtHolder;
  42.         end;
  43.     if itsMaximum = itsMinimum then
  44.         begin
  45.             {$IFC qDebug}
  46.             Warning( 2 );
  47.             {$ENDC}
  48.             itsMaximum := itsMaximum + 1;
  49.         end;
  50.     fMinimum := itsMinimum;
  51.     fMaximum := itsMaximum;
  52.     fPrecision := itsPrecision;
  53.     if fPrecision > MaxPrec then
  54.        begin
  55.     {$IFC qDebug}
  56.             PrecWarning;
  57.     {$ENDC}
  58.            fPrecision := MaxPrec;
  59.        end;
  60.     if itsValue <> '' then { allow null string entries }
  61.        begin
  62.             ExtHolder := Str2Num ( itsValue );
  63.             if (ExtHolder < itsMinimum) or (ExtHolder > itsMaximum) then
  64.                 begin
  65.             {$IFC qDebug}
  66.                     Warning ( 3 );
  67.             {$ENDC}
  68.                 { Convert the value to the decimal precision required }
  69.                  Mask.Digits := MaxPrec;
  70.                     Mask.Style  := FixedDecimal;
  71.                     Num2Str ( Mask , itsMinimum , DecStr(itsValue) );
  72.                 end;
  73.         end;
  74.     SetText( itsValue , kDontRedraw);
  75.     fValue := itsValue;
  76. END;
  77. {$ENDC}
  78.  
  79.  
  80. {$IFC qTemplateViews}
  81. {$S DlgOpen}
  82. {-----------------------------------+
  83. |    IRes                                     |
  84. +-----------------------------------}
  85. PROCEDURE TExtendedText.IRes (itsDocument: TDocument; itsSuperView: TView;
  86.                                         VAR itsParams: Ptr); OVERRIDE;
  87.  
  88. Var
  89.     IntHolder:  integer;
  90.     
  91. BEGIN
  92.     INHERITED IRes(NIL, itsSuperView, itsParams);
  93.  
  94.     WITH ExtendedTextTemplatePtr(itsParams)^ DO
  95.         BEGIN
  96.             if minimum > maximum then
  97.                begin
  98.                     {$IFC qDebug}
  99.                     Warning ( 1 );
  100.                     {$ENDC}
  101.                     IntHolder := minimum;
  102.                     minimum := maximum;
  103.                     maximum := IntHolder;
  104.                 end;
  105.             if minimum = maximum then
  106.                 begin
  107.                     {$IFC qDebug}
  108.                     Warning( 2 );
  109.                     {$ENDC}
  110.                     Maximum := Maximum + 1;
  111.                 end;
  112.             fMinimum := minimum;
  113.             fMaximum := maximum;
  114.             fPrecision := prec;
  115.             if fPrecision > MaxPrec then
  116.                 begin
  117.             {$IFC qDebug}
  118.                     PrecWarning;
  119.             {$ENDC}
  120.                     fPrecision := MaxPrec;
  121.                end;
  122.  
  123.             { Would like to check to see if Value is within Min/Max at this     }
  124.             { point but cannot because we would have to call Str2Num to convert }
  125.             { the value into a extended type to check it.  Str2Num is one of    }
  126.             { those nasty routines that can move memory around and it will cause}
  127.             { a crash here.  Believe me, I tried.                               }
  128.             
  129.             { Because of the above, we cannot force the decimal precision of the}
  130.             { initial value loaded from the resource by calling Str2Num and     }
  131.             { Num2Str.  Just make sure that your initial value string in your   }
  132.             { resource is formatted correctly according to your dec precision.  }
  133.             
  134.             fValue := value;
  135.             SetText(value, kDontRedraw);
  136.             {$IFC qDebug}
  137.             if gIntenseDebugging then
  138.                 begin
  139.                     Writeln ( 'fMinimum   = ' , fMinimum );
  140.                     Writeln ( 'fMaximum   = ' , fMaximum );
  141.                     Writeln ( 'fPrecision = ' , fPrecision );
  142.                     Writeln ( 'fValue     = ' , fValue );
  143.                 end;
  144.             {$ENDC}
  145.         END;
  146.  
  147.     OffsetPtrWStr(itsParams, SIZEOF(ExtendedTextTemplate));
  148. END;
  149. {$ENDC}
  150.  
  151.  
  152. {$IFC qWriteTemplates}
  153. {$S MAWriteRes}
  154. {-----------------------------------+
  155. |    WRes                                     |
  156. +-----------------------------------}
  157. PROCEDURE TExtendedText.WRes (theResource: ViewRsrcHndl; VAR itsParams: Ptr); OVERRIDE;
  158.  
  159. VAR
  160.     nmPtr:        ExtendedTextTemplatePtr;
  161.     Mask:        DecForm;
  162.     theValue:    Str255;
  163.  
  164. BEGIN
  165.     INHERITED WRes(theResource, itsParams);
  166.     
  167.     GetText ( theValue ); { Get the text so we can get the length }
  168.     
  169.     nmPtr := ExtendedTextTemplatePtr(ExpandPtrWStr(theResource, itsParams,
  170.       SIZEOF(ExtendedTextTemplate) , Length(theValue) ));
  171.  
  172.     WITH nmPtr^ DO
  173.         BEGIN
  174.             Mask.Style := FixedDecimal;
  175.             Mask.Digits := fPrecision;
  176.             Num2Str ( Mask , GetValue , DecStr(Value) );
  177.             minimum := Num2LongInt (fMinimum);
  178.             maximum := Num2LongInt (fMaximum);
  179.             prec := fPrecision;
  180.         END;
  181. END;
  182.  
  183. {$S MAWriteRes}
  184. {-----------------------------------+
  185. |    WriteRes                                 |
  186. +-----------------------------------}
  187. PROCEDURE TExtendedText.WriteRes (theResource: ViewRsrcHndl; 
  188.                                              VAR itsParams: Ptr); OVERRIDE;
  189. BEGIN
  190.     gWResSignature := 'xnum';    { This MUST be unique. }
  191.     gWResType := 'TExtendedText';
  192.     WRes(theResource, itsParams);
  193. END;
  194. {$ENDC}
  195.  
  196.  
  197. {$S DlgRes}
  198. {-----------------------------------+
  199. |    NotNull                                 |
  200. +-----------------------------------}
  201.  
  202. { NotNull will return TRUE if the current string in the TExtendedText edit }
  203. { box is not ''.  Use this before the call to GetValue to make sure that   }
  204. { an entry has been made.  i.e. IF NotNull THEN myNum := GetValue          }
  205.  
  206. FUNCTION  TExtendedText.NotNull: Boolean;
  207.  
  208. var
  209.    aString        : Str255;
  210. begin
  211.    GetText ( aString );
  212.     NotNull := aString <> '';
  213. end;
  214.  
  215. {-----------------------------------+
  216. |    GetValue                                 |
  217. +-----------------------------------}
  218. FUNCTION  TExtendedText.GetValue: Extended;
  219.  
  220. VAR
  221.     aString:            Str255;
  222.     theValue:        Extended;
  223.  
  224. BEGIN
  225.     GetText(aString);
  226.     if aString <> '' then
  227.        begin
  228.            theValue := Str2Num(aString);
  229.           GetValue := theValue;
  230.           fValue := aString;
  231.         end
  232.     else
  233.         GetValue := Self.fMinimum; { if its null, we must set it to something }
  234. END;                                       { See NotNull function above.              }
  235.  
  236.  
  237. {$S DlgNonRes}
  238. {-----------------------------------+
  239. |    SetValue                                 |
  240. +-----------------------------------}
  241. PROCEDURE TExtendedText.SetValue (newValue: Extended; redraw: BOOLEAN);
  242.  
  243. VAR
  244.     aString:        DecStr;
  245.     Mask:            DecForm;
  246.  
  247. BEGIN
  248.     if newValue < fMinimum then newValue := fMinimum;
  249.     if newValue > fMaximum then newValue := fMaximum;
  250.     Mask.digits := fprecision;
  251.     Mask.style := FixedDecimal;
  252.     Num2Str ( Mask , newValue , aString );
  253.     SetText(aString, redraw);
  254.     fValue := aString;
  255. END;
  256.  
  257.  
  258. {$S DlgNonRes}
  259. {-----------------------------------+
  260. |    Validate                                 |
  261. +-----------------------------------}
  262. FUNCTION TExtendedText.Validate: LONGINT; OVERRIDE;
  263.  
  264.     VAR
  265.         theString:            Str255;
  266.         decRec:             Decimal;
  267.         extValue:            Extended;
  268.         index:                INTEGER;
  269.         validPrefix:        BOOLEAN;
  270.  
  271.     BEGIN
  272.     Validate := kValidValue;
  273.  
  274.     GetText(theString);
  275.     IF theString = '' THEN
  276.         theString := '0';
  277.  
  278.     index := 1;
  279.     Str2Dec(theString, index, decRec, validPrefix);
  280.     IF validPrefix & (index > LENGTH(theString)) THEN
  281.         BEGIN
  282.         extValue := Dec2Num(decRec);
  283.         IF extValue < fMinimum THEN
  284.             Validate := kValueTooSmall
  285.         ELSE IF extValue > fMaximum THEN
  286.             Validate := kValueTooLarge;
  287.         END
  288.     ELSE
  289.         Validate := kNonNumericCharacters;
  290.     END;
  291.     
  292.     
  293. {$S DlgRes}
  294. {-----------------------------------+
  295. |    DoKeyCommand                          |
  296. +-----------------------------------}
  297.  
  298. { This will filter out any keys other than Numbers, the Enter key, the Return key, }
  299. { the Tab key, the Backspace key and, if the Textended OBJECT will accept negative }
  300. { values, the minus key.                                                           }
  301.  
  302. Function TExtendedText.DoKeyCommand ( ch : char; aKeyCode: integer;
  303.                                       VAR info : eventInfo):TCommand;OVERRIDE;
  304.                                       
  305. var
  306.  
  307.     GoodSet : set of char;
  308.  
  309. begin
  310.    if (fTEView <> NIL) then
  311.       begin
  312.             GoodSet := ['0','1','2','3','4','5','6','7','8','9','.',
  313.                         chEnter,chReturn,chTab,chBackSpace];
  314.             if fMinimum < 0 then GoodSet := GoodSet + ['-'];
  315.             if NOT (ch in GoodSet) then
  316.                 begin
  317.                     SysBeep ( 5 );  { Maybe take this annoying beep out??? }
  318.                     DoKeyCommand := gNoChanges;
  319.                 end
  320.             else
  321.                 DoKeyCommand := INHERITED DoKeyCommand ( ch , aKeyCode , info );
  322.       end;
  323. end;
  324.  
  325. {$IFC qDebug}
  326. {$S DlgFields}
  327.     {-----------------------------------+
  328.     |    Fields                                  |
  329.     +-----------------------------------}
  330.     
  331.     { Be sure to include the MyFieldToStr procedure in your main unit and }
  332.     { set the gFieldToStrRtn variable to point to it in you IApplication  }
  333.     { P.S.  Dont forget the constants either.                             }
  334.     
  335.     PROCEDURE TExtendedText.Fields (PROCEDURE DoToField (fieldName: Str255;
  336.                                                      fieldAddr: Ptr;
  337.                                                      fieldType: INTEGER)); OVERRIDE;
  338.                                                      
  339.     BEGIN
  340.         DoToField('TExtendedText', NIL, bClass);
  341.         DoToField('fValue', @fValue, bString);
  342.         DoToField('fMinimum', @fMinimum, bExtended);
  343.         DoToField('fMaximum', @fMaximum , bExtended);
  344.         DoToField('fPrecision' , @fPrecision , bInteger);
  345.         INHERITED Fields(DoToField);
  346.     END;
  347.     
  348.     {-----------------------------------+
  349.     |    Warning                                  |
  350.     +-----------------------------------}
  351.     
  352.     PROCEDURE TExtendedText.Warning( ErrorNum : integer);
  353.  
  354.     var
  355.        message0  : str255;
  356.         message1  : str255;
  357.         message2  : str255;
  358.         loop      : integer;
  359.         
  360.     begin
  361.         CASE ErrorNum of
  362.            1 : begin
  363.                     Message0 := 'Your Minimum value is larger than your ';
  364.                     Message1 := 'Maximum in the TExtendedText View ';
  365.                     Message2 := 'They have been switched.';
  366.                  end;
  367.             2 : begin
  368.                     Message0 := 'Your Minimum and Maximum values are equal in';
  369.                     Message1 := 'the TExtendedText View ';
  370.                     Message2 := 'Maximum has been set to Maximum + 1';
  371.                 end;
  372.             3 : begin
  373.                     Message0 := 'Your value is not within the range of your';
  374.                     Message1 := 'Min and Max values in the TExtendedText View ';
  375.                     Message2 := 'It has been set to your Min value.';
  376.                  end;
  377.         end; {CASE}
  378.             
  379.         Writeln ('***************************************************');
  380.         Writeln ('*          ! ! ! W A R N I N G ! ! !              *');
  381.         Writeln ('***************************************************');
  382.         Writeln;
  383.         Writeln ( message0 );
  384.         Write   ( message1 );
  385.         for loop := 1 to 4 do write ( fIdentifier[loop]);
  386.         Writeln ( '.' );
  387.         Writeln ( message2 );
  388.         Writeln;
  389.         SysBeep ( 5 );
  390.    end;
  391.     
  392.     {-----------------------------------+
  393.     |    PrecWarning                               |
  394.     +-----------------------------------}
  395.     
  396.     PROCEDURE TExtendedText.PrecWarning;
  397.     
  398.     var
  399.         loop      : integer;
  400.  
  401.     begin
  402.         Writeln ('***************************************************');
  403.         Writeln ('*          ! ! ! W A R N I N G ! ! !              *');
  404.         Writeln ('***************************************************');
  405.         Writeln;
  406.         Writeln ( 'A precision value more than' , MaxPrec:1 , ' is unusual.  Your');
  407.         Writeln ( 'value is presently set at: ' , fPrecision:2 , ' for the' );
  408.         Write   ( 'TExtendedTextView ');
  409.         for loop := 1 to 4 do Write ( fIdentifier[loop] );
  410.         Writeln ( '.  It has been reset to ' , MaxPrec:1 , '.');
  411.         Writeln;
  412.         SysBeep ( 5 );
  413.    end;
  414.  
  415.  
  416. {$ENDC}
  417.  
  418. end.